home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #15 / Monster Media Number 15 (Monster Media)(July 1996).ISO / tbbs / prgsourc.zip / HOMES.ZIP / PDES.PRG < prev    next >
Text File  |  1996-01-08  |  9KB  |  216 lines

  1. PROCEDURE pdes          
  2. PARAMETERS md
  3.  
  4. PRIVATE x
  5. PRIVATE y
  6.  
  7. DECLARE ades[20]
  8. IF md = 2
  9.    ades[1] =  ".............."
  10. ELSE
  11.    ades[1] =  "..Any         "
  12. ENDIF
  13. ades[2] =  "A-Frame       "
  14. ades[3] =  "Cape Cod      "
  15. ades[4] =  "Classical     "
  16. ades[5] =  "Colonial      "
  17. ades[6] =  "Condominium   "
  18. ades[7] =  "Contemporary  "
  19. ades[8] =  "Double-wide   "
  20. ades[9] =  "Dutch Roof    "
  21. ades[10] = "Empire        "
  22. ades[11] = "Gothic        "
  23. ades[12] = "Italian       "
  24. ades[13] = "Ranch         "
  25. ades[14] = "Spanish       "
  26. ades[15] = "Split Level   "
  27. ades[16] = "Townhouse     "
  28. ades[17] = "Traditional   "
  29. ades[18] = "Trailer       "
  30. ades[19] = "Tudor         "
  31. ades[20] = "Victorian     "
  32.  
  33. SET COLOR TO GR+/R
  34. @ 21,0 CLEAR TO 23,79
  35. @ 21,5 SAY "Up/Dn Arrow "
  36. @ 22,5 SAY "<Enter> "
  37. @ 23,5 SAY "?"
  38. SET COLOR TO W+/R
  39. @ 21,17 SAY "= Move within pick list"
  40. @ 22,13 SAY "= Select from pick list"
  41. @ 23,7 SAY "Help"
  42. SET COLOR TO BG/BG
  43. @ 3,52 CLEAR TO 19,68
  44. SET COLOR TO N/BG
  45. @ 3,52 TO 19,68
  46.  
  47. x = 1
  48. y = 4
  49. DO WHILE x <= 20 .AND. y <= 18
  50.    @ y,53 SAY ades[x]
  51.    x = x + 1
  52.    y = y + 1
  53. ENDDO
  54.  
  55. SET COLOR TO GR+/BG
  56. @ 4,53 SAY ades[1]
  57.  
  58. x = 1
  59. y = 4
  60. SET FORMAT TO fscr NOCLEAR
  61. SET COLOR TO N/N
  62. @ 2,0 GET charin
  63. DO WHILE .T.
  64.    READ
  65.    DO CASE
  66.       CASE LastKey() = 5                         && <Up Arrow>
  67.            IF x = 1
  68.               LOOP
  69.            ENDIF
  70.            SET COLOR TO N/BG
  71.            IF y = 4
  72.               x = x - 1
  73.               DO WHILE y <= 18
  74.                 @ y,53 SAY ades[x]
  75.                 x = x + 1
  76.                 y = y + 1
  77.               ENDDO
  78.               x = x - 15
  79.               y = 4
  80.            ELSE
  81.               @ y,53 SAY ades[x]
  82.               x = x - 1
  83.               y = y - 1
  84.            ENDIF
  85.  
  86.            SET COLOR TO GR+/BG
  87.            @ y,53 SAY ades[x]
  88.            LOOP
  89.            
  90.       CASE LastKey() = 13                        && <Enter>
  91.            IF md = 2 .AND. x = 1
  92.               LOOP
  93.            ENDIF
  94.            REPLACE design WITH ades[x]
  95.            EXIT
  96.       
  97.       CASE LastKey() = 24                        && <Dn Arrow>
  98.            IF x = 20
  99.               LOOP
  100.            ENDIF
  101.            SET COLOR TO N/BG
  102.            IF y = 18
  103.               x = (x - 15) + 2
  104.               y = 4
  105.               DO WHILE x < 20 .AND. y < 18
  106.                 @ y,53 SAY ades[x]
  107.                 x = x + 1
  108.                 y = y + 1
  109.               ENDDO
  110.            ELSE
  111.               @ y,53 SAY ades[x]
  112.               x = x + 1
  113.               y = y + 1
  114.            ENDIF
  115.            SET COLOR TO GR+/BG
  116.            @ y,53 SAY ades[x]
  117.            LOOP
  118.       
  119.       CASE LastKey() = 27                       && <Esc>
  120.            IF md = 2
  121.               DO BoxB WITH 4,20,6,46
  122.               @ 5,22 SAY "You must pick a design."
  123.               key = InKey(4)
  124.               DO cls WITH 4,20,6,46
  125.               LOOP
  126.            ENDIF
  127.            EXIT
  128.       
  129.       CASE LastKey() = 63                       && `?': Help
  130.            IF x = 1 .OR. x = 6 .OR. x = 8 .OR. x = 16 .OR. x = 18
  131.               LOOP
  132.            ENDIF
  133.            SET COLOR TO B/B
  134.            @ 20,5 CLEAR TO 22,75
  135.            SET COLOR TO W+/B
  136.            DO CASE
  137.               CASE x = 2
  138.                    @ 20,6 SAY "A-Frame                                          RARE, 1940 - Present"
  139.                    @ 21,6 SAY "A steep A-shaped roof forms the side walls of the home, framing a"
  140.                    @ 22,6 SAY "small 2nd story."
  141.               CASE x = 3
  142.                    @ 20,6 SAY "Cape Cod                                               1700 - Present"            
  143.                    @ 21,6 SAY "Steep roof with peaks at the side, the 2nd story is formed by the"  
  144.                    @ 22,6 SAY "roof, making it smaller than lower story. Often with dormer windows."
  145.               CASE x = 4
  146.                    @ 20,6 SAY "Classical                                RARE, originally 1770 - 1860"
  147.                    @ 21,6 SAY "Large round front porch columns with square bases. The peak of the" 
  148.                    @ 22,6 SAY "porch roof faces front and forms a triangle above the columns."
  149.               CASE x = 5
  150.                    @ 20,6 SAY "Colonial                                       originally 1700 - 1820"
  151.                    @ 21,6 SAY "Usually 2-story; with roof peaks at the side or hipped, evenly spaced"
  152.                    @ 22,6 SAY "identical windows and a (usually) centered, classical doorway." 
  153.               CASE x = 7
  154.                    @ 20,6 SAY "Contemporary                                           1940 - Present"
  155.                    @ 21,6 SAY "Various styles usually having varied roof lines and/or a modular look"
  156.                    @ 22,6 SAY "and larger windows, including picture windows."
  157.               CASE x = 9
  158.                    @ 20,6 SAY "Dutch Roof                               RARE, originally 1750 - 1840"
  159.                    @ 21,6 SAY "The top story is formed by a side-peaked gambrel roof, hipped like" 
  160.                    @ 22,6 SAY "a barn roof. Often with dormer windows and/or flared eaves"
  161.               CASE x = 10
  162.                    @ 20,6 SAY "Empire                                   RARE, originally 1855 - 1885"
  163.                    @ 21,6 SAY "A Mansard Roof is the most distinguishing feature - a steep rise up" 
  164.                    @ 22,6 SAY "to a flat top, usually with dormer windows, often on all sides."
  165.               CASE x = 11
  166.                    @ 20,6 SAY "Gothic                                   RARE, originally 1840 - 1880"
  167.                    @ 21,6 SAY "Walls rise with no break to a high-peaked front-facing roof, usually"
  168.                    @ 22,6 SAY "with highly decorative eaves, sometimes with cathedral-style windows."
  169.               CASE x = 12
  170.                    @ 20,6 SAY "Italian                                  RARE, originally 1840 - 1885"
  171.                    @ 21,6 SAY "Arched, not peaked, windows and a low pitched or flat roof, are the" 
  172.                    @ 22,6 SAY "main features. Usually 2-story, often with narrow grouped windows"
  173.               CASE x = 13
  174.                    @ 20,6 SAY "Ranch                                                  1935 - Present"
  175.                    @ 21,6 SAY "Single story with a moderately-pitched roof. The main roof line runs"
  176.                    @ 22,6 SAY "side-to-side, but there may be wings creating L or U shapes."
  177.               CASE x = 14
  178.                    @ 20,6 SAY "Spanish                                              most 1890 - 1950"
  179.                    @ 21,6 SAY "Walls usually stucco, roof often red tile, with thick, square porch"
  180.                    @ 22,6 SAY "supports, often with arched entryways."
  181.               CASE x = 15
  182.                    @ 20,6 SAY "Split Level                                            1955 - Present"
  183.                    @ 21,6 SAY "Essentially a single-level and a 2-story house combined so that none"
  184.                    @ 22,6 SAY "of the three levels are at the same elevation."
  185.               CASE x = 17
  186.                    @ 20,6 SAY "Traditional                                       usually 1900 - 1950"
  187.                    @ 21,6 SAY "Usually square or nearly square, minimal decoration, tin roofs are" 
  188.                    @ 22,6 SAY "common, porch supports are thick and square or of decorative steel."   
  189.               CASE x = 19
  190.                    @ 20,6 SAY "Tudor                                                  1910 - Present"
  191.                    @ 21,6 SAY "At least one predominant peak is front-facing, usually with exposed"
  192.                    @ 22,6 SAY "beams on walls, sometimes with an overhanging second story"
  193.               CASE x = 20
  194.                    @ 20,6 SAY "Victorian                                                 1860 - 1910"
  195.                    @ 21,6 SAY "Nearly all with elaborate porches, some with porch gazebos and round"  
  196.                    @ 22,6 SAY "towers, tin roofs are common, as are multi-level roof designs."
  197.           ENDCASE
  198.           key = InKey(18)
  199.           DO cls WITH 20,0,20,79
  200.           SET COLOR TO GR+/R
  201.           @ 21,0 CLEAR TO 23,79
  202.           @ 21,5 SAY "Up/Dn Arrow "
  203.           @ 22,5 SAY "<Enter> "
  204.           SET COLOR TO W+/R
  205.           @ 21,17 SAY "= Move within pick list"
  206.           @ 22,13 SAY "= Select from pick list"
  207.           LOOP
  208.       OTHERWISE
  209.           LOOP
  210.    ENDCASE
  211. ENDDO
  212. RELEASE ades
  213. DO cls WITH 3,52,19,68
  214. RETURN
  215.  
  216.